The X-Philes (2nd Revision)/The X-Philes Number 1 (1995).iso/xphiles/hp48_1/tsq_jl

Internet Message Format | 1995-03-31 | 15KB

From: john Latala <[e-mail]>
Subject:  v03i040:  tsq_jl - Times Square horizontally scrolling large text v1.0, Part01/01
Newsgroups: comp.sources.hp48
Organization: NCR Canada Ltd, Waterloo, Ontario, Canada.
Followup-To: comp.sys.hp48
Approved: [e-mail]

Checksum: 2593912457 (verify with brik -cv)
Submitted-by: john Latala <[e-mail]>
Posting-number: Volume 3, Issue 40
Archive-name: tsq_jl/part01


BEGIN_DOC tsq.doc
I posted a version of this quite some time back for the HP28. Here's my
HP48 version of it.

The design of this version is quite different from the '28 version. That
one had only one font available. This version uses a program to
'enlarge' the normal font.

The routine MKFONT takes three arguments:

    - String of desired character set
    - HP48 font number (1, 2, 3)
    - zoom factor (usually 2, 3, 4)

Eventually the program stops after creating a character set list
varialbe that contains a string of the character set and a large GROB of
the bitmap.  The routine will save the character set list in a variable
called: FfZz where 'f' is the supplied font and 'z' is the supplied zoom
factor.  The character sets F3Z2 and F3Z3 work quite nicely.

You only have to run MKFONT to create the character set lists the first
time. You can probably only keep these around if you have a RAM card
installed in your '48 because they're quite large. Here are the sizes as
returned by the BYTES program for various fonts:

    Font    Size
    ----    ----
    F3Z2    4988.5
    F3Z3    10988.5
    F3Z4    19388.5

To finally display a message put the message string on the stack, put a
character set list on the stack then run the TSQ program itself. The
large characters will scroll horizontally across the screen.

Any characters that are in the message, but not in the supplied
character set list are ignored ( to change this look at T\->G ).

While TSQ is running a number of keys are usable:

    Key        Usage
    ---        -----
    ENTER        restart the display from the beginning
    +         Increase the number of pixels moved
    -        Dexrease the number of pixels moved
    *        Increase the time delay between updates
    /        Decrease the time delay between updates
    other        Stop program after this pass ends

If you want to stop right away you can press any key, then the ENTER to
force a new pass to start.

When moving the message across the screen in large steps it looks better
to also use a large delay between screen updates.

The routine used to make the character set list is kind of slow, but it
does work and only has to be run once...

Once problem that I had with this program was that any GROB stored into
PICT can't be wider than 2048 pixels. If you're using one of the larger
fonts and/or a long message this can easily be exceeded.

The initial version of the program just created the large GROB, stored
it on PICT then used PVIEW to walk 'down' the length of the GRBO making
it look like a scrolling display. This was quicker, but would blow up
when the GROB was wider than 2048 pixels.

Enough talking, here's the program as a directory:
END_DOC


BEGIN_ASC tsq.asc
%%HP: T(3)A(D)F(.);
"69A20FF726E00000003045D87430D9D20E1632B7FC18DBF11C432D6E2030D637
76D6E207036861627375647D6E2060269647D61607E1632D6E2060269647D616
078B9C1BB691DBBF1BB691D6E2070368616273756478B9C150FA11C432D6E207
036865696768647D6E2060367796464786E1632D6E2060367796464786D6E203
0D637768B9C1EEDA1B9691D6E207036865696768647B9691614E1C2A20520002
45796C64696E67602269647D61607E29C2A2485A19C2A2D6E2030D637768B9C1
0A132D6E201096D6E201096B0BC1C2A20700000276BA1D6E201096D6E2030D63
7768B9C150FA1339202000000000000010EEDA14B2A255DB1B0BC176BA1C2A20
700005276BA1ED2A2485A1D6E2010969C2A290DA1D6E2060367796464786EEDA
1B9691E4A20510000000000000000000ED2A2387C1D6E2060269647D61607D6E
207036861627375647D6E2030D63776D6E201096D6E201096C58C14BAC13CE22
78BF14B2A2D9AE1AFE22D9D209C2A290DA1D6E2060367796464786EEDA1B9691
E4A20510000000000000000000ED2A2387C178BF1B7FC18DBF1D6E2070368656
967686479C2A290DA176BA1DBBF1D6E20603677964647869C2A290DA176BA1DB
BF1ED2A2387C1C58C1AE8C1B21305BF22D9D208DBF18DBF18DBF1B21305DF22C
4232EF532EF53293632B21306C3003045351530D9D20E1632B7FC18DBF11C432
D6E2030D63776D6E207036861627375647D6E2060269647D61607E1632D6E206
0269647D616078B9C1BB691DBBF1BB691D6E2070368616273756478B9C150FA1
1C432D6E207036865696768647D6E2060367796464786E1632D6E2030D63776D
6E207036861627375647D6E2060269647D61607ED2A2387C184E203045D87478
BF18B9C1DBBF1BB691C2A2091000269647D6160702963702DBBF1B0BC176BA1C
2A20D00000226970276BA1DBBF1BB691B0BC176BA19C2A2485A19C2A2F17A178
BF18B9C18DBF133920200000000000262076BA1339201000000000000230D6E2
07036865696768647ED2A250FA176BA1B9691614E1DBBF1E4A20510003800000
000000000E4A20510000200000000000000D6E207036865696768647ED2A250F
A190DA1ED2A2387C1DBBF1AE8C178BF18B9C1BB691DBBF1BB691DBBF19C2A24B
2A24B2A21C432D6E20407627F626D6E2060767796464786D6E20707686569676
8647D6E204037475607D6E204046F6E656D6E204077169647E1632E4A2051000
3800000000000000E4A20510000400000000000000614E1634E1DCC0247A20E4
A20510000000000000000000E4A20510000000000000000000B21300F2E13C03
24B2A2D6E206076779646478633920200000000000131090DA10A132D6E20108
7634E147A20E4A20510000000000000000000E4A20510000000000000000000B
2130D6E20407627F626D6E201087B9691E4A20510000000000000000000ED2A2
387C1D6E20108733920200000000000031076BA1B9691E4A2051000040000000
0000000ED2A2387C1C58C1AE8C13CE22D6E2040771696474B2A2D9AE1AFE22D9
D20D6E204077169647F17A1B21305DF223CE22378A1AFE22D9D201C432D6E201
0B6E1632D8732D9D20D6E2010B6339201000000000000150279E18A732D9D20D
6E2060767796464786D6E20108776BA145632D6E20108797632DCC02B21305DF
22D6E2010B6339201000000000000560279E18A732D9D20D6E20407716964733
920999000000000001090DA14B2A217CB145632D6E20407716964797632DCC02
B21305DF22D6E2010B6339201000000000000570279E18A732D9D20339209990
00000000001045632D6E20407716964797632B4402B21305DF22D6E2010B6339
201000000000000580279E18A732D9D20D6E2040374756079C2A290DA19C2A21
7CB145632D6E20403747560797632DCC02B21305DF22D6E2010B633920100000
0000000590279E18A732D9D20D6E2040374756079C2A276BA1D6E20607677964
6478633920200000000000131090DA1ED2A250FA13ECB145632D6E2040374756
0797632DCC02B21305DF229C2A28A732D9D209C2A245632D6E204046F6E65697
632DCC02B21305DF22B21305DF22EF532B21305DF22D6E20403747560708332D
E032D6E204046F6E6569B632EF532EF532EF53293632B21304580060D4B464F4
E44560D9D20E16321C432D6E207036861627375647D6E204066F6E647D6E2040
A7F6F6D6E1632C2A207000085D6E204066F6E647DA5E18B9C1BB691DBBF1BB69
11C432D6E207036865696768647D6E2060367796464786E1632C2A2072000D41
6B696E67602C6162776560266F6E64733920100000000000001066BC176BA1C2
A209200005C656163756022656020716479656E647E276BA19C2A2485A1D6E20
7036861627375647D6E207036861627375647D6E204066F6E647DA5E1D6E2040
A7F6F6D684E2060249474745425ED2A2387C1C2A20900007264D6E204066F6E6
47B0BC176BA1C2A2070000A576BA1D6E2040A7F6F6D6B0BC176BA1C2A2070000
7276BA1B7FC1DCC02EF532EF53293632B2130F22006024947474542560D9D20E
163292CF18B9C1BB691DBBF1BB691DBBF11C432D6E2050F67627F626D6E2010A
7D6E201077D6E201086E1632D6E201077D6E2010A7EEDA1B9691D6E201086D6E
2010A7EEDA1B9691614E1D6E2010A7B969178BF1614E1599A11C432D6E203026
C6B6E16324B2A2D6E2010779C2A290DA10A132D6E201087D6E201087D6E20107
750FA1339203000000000000010EEDA1D6BB133920100000000000001050FA1B
0BC133920100000000000001066BC1C2A205000076BA176BA19C2A2485A13CE2
2D6E2050F67627F626D6E201087B9691E4A20510000000000000000000ED2A23
87C1D6E201087B9691D6E201086B9691ED2A2387C1C58C1E4A20510001000000
000000000D6E201086B9691614E1D9AE1AFE22D9D204B2A2D6E2010869C2A290
DA10A132D6E2010973CE22D6E2050F67627F626D6E201087B9691D6E201097B9
691ED2A2387C178BF1C58C1E1B2011000100001000010279E1AFE22D9D20D6E2
01087D6E2010A7EEDA1B9691D6E201097D6E2010A7EEDA1B9691ED2A2387C1D6
E203026C6B6AE8C1B21305DF22C4232B21305DF22C4232EF532EF53293632B21
30A1EB"
END_ASC

BYTES: #BE1Ah 2280.5

BEGIN_UU tsq.uue
begin 644 tsq
M2%!(4#0X+466*O!_8@X````#5(U'`YTMX&$C>\^!O1_!--+F`@-M<V=M+G`P*
MAA8F-U=&U^8"!F)I=&UA<!XVTN8"!F)I=&UA<+C)L6L9O?NQ:QEM+G`PAA8FC
M-U=&AYL<!:\13"-M+G`PAE:6=H9&U^8"!F-W:61T:!XVTN8"!F-W:61T:&TN.
M,-`V=X:;'.ZML6D9;2YP,(96EG:&1K=I&1;DP:(")0`@5)?&1I;F=@8BED;7N
M%@;GDBPJA*61+"IM+C#0-G>&FQR@,=+F`@%I;2X0D+:P'"PJ<```(&>KT>8"6
M`6EM+C#0-G>&FQP%KS&3`@(````````![JU!*RI5O;&P'&>KP:("!P!0<K8:G
MWJ)"6!IM+A"0EBPJ":W1Y@(&8W=I9'1H[JVQ:1E.*E`!````````````WJ(RF
M>!QM+F`@ED;7%@;7Y@('8VAA<G-E=&TN,-`V=];F`@%I;2X0D,:%'+3*,>PBY
MA_M!*RJ=ZJ'O(ITMD"PJ":W1Y@(&8W=I9'1H[JVQ:1E.*E`!````````````0
MWJ(R>!R'^['W'-C[T>8"!V-H96EG:'3)HI+0&F>KT;L?;2Y@,':71D:'EBPJH
M":UQMAJ]^^$M*H/'P84<ZLBQ$@.U+]+9`MC[@;T?V/NQ$@/5+\(D(_XUXE\C8
M.3:R$@/&`S!`-14UT-D"'C:R]QS8^Q%,(VTN,-`V=];F`@=C:&%R<V5T;2Y@Y
M()9&UQ8&YV$C;2Y@()9&UQ8&AYL<NY;1NQ^[EM'F`@=C:&%R<V5TN,E1\!K![
M--+F`@=C:&5I9VAT;2Y@,':71D:'YF$C;2XPT#9WUN8"!V-H87)S971M+F`@"
MED;7%@;G+2J#QX'D`@-4C4>'^X&;'+W[L6L9+"J0`0!B:71M87`@:7,@O?NQ!
ML!QGJ\&B`@T``"*6!W*V&KW[L6L9"\MQMAK)HD)8&LFB\G$:A_N!FQS8^S&3L
M`@(``````&("9ZLQDP(!```````@`VTN<#"&5I9VAD;G+2H%KW&V&IN684$>A
MO?OAI`(5`#`(````````X*0"%0```@```````-#F`@=C:&5I9VATWJ)2\!H)Z
MK>$M*H/'T;L?ZLAQN!^XR;%K&;W[L6L9O?N1+"JTHD(K*L$TTN8"!&=R;V)M.
M+F!P=I=&1H?6Y@('9VAE:6=H=&TN0#!'5P;7Y@($9&]N96TN0'`7ED;G82-.`
M*E`!`(,`````````3BI0`0!``````````!;D84,>S0Q"IP).*E`!````````O
M````3BI0`0```````````"LQ`"\>PS!"*RIM+F!P=I=&1H<VDP("```````Q6
M`0FM`1HC;2X0@&=#'G0JX*0"%0```````````."D`A4```````````"P$@-M$
M+D!P)O<FUN8"`7B;EN&D`A4```````````#@+2J#Q]'F`@%X,RD@````````$
M$W"V&IN6X:0"%0``!````````.`M*H/'P84<ZL@Q[")M+D!P%Y9&1RLJG>JAK
M[R*=+=#F`@1W86ET'Z>Q$@/5+S+L(G.HH>\BG2T03"-M+A"PYF$CC3?2V0)M]
M+A"P-I,"`0``````$`5RZ8%Z(YTMT.8"!F=W:61T:&TN$(!WMAI4-M+F`@%X5
M>3;2S"`K,5#](FTN$+`VDP(!``````!0!G+I@7HCG2W0Y@($=V%I=#,ID)D`,
M`````!"0T!JTHA+'&U0VTN8"!'=A:71Y-M+,("LQ4/TB;2X0L#:3`@$`````E
M`%`'<NF!>B.=+3"3`ID)```````!5#;2Y@($=V%I='DVLD0@*S%0_2)M+A"P2
M-I,"`0``````4`ARZ8%Z(YTMT.8"!'-T97#)HI+0&LFB$L<;5#;2Y@($<W1E/
M<'DVTLP@*S%0_2)M+A"P-I,"`0``````4`ERZ8%Z(YTMT.8"!'-T97#)HG*V&
M&FTN8'!VET9&AS:3`@(``````#$!":WA+2H%KS'.&U0VTN8"!'-T97!Y-M+,_
M("LQ4/TBR:*">B.=+9`L*E0VTN8"!&1O;F5Y-M+,("LQ4/TB*S%0_2+^-;(29
M`]4OTN8"!'-T97"`,](.(VTN0$#VYE:6:R/^->)?(_XUDF,C*S%`A0`&34M&]
M3TY4!ITMX&$CP332Y@('8VAA<G-E=&TN0&#VYD;7Y@($>F]O;1XVPJ("!P"`"
MU>8"!&9O;G2MY8&;'+N6T;L?NY813"-M+G`PAE:6=H9&U^8"!F-W:61T:!XVP
MPJ(")P#0%+:6YG8&PA8F=U8&8O;F1C>3`@$````````!9LMQMAHL*I`"`%!LK
M96%S92!B92!P871I96YT+F>KD2PJA*71Y@('8VAA<G-E=&TN<#"&%B8W5T;7]
MY@($9F]N=*WET>8"!'IO;VU(+F`@E'1T5"3E+2J#Q\&B`@D`<&+4Y@($9F]NP
M=`O+<;8:+"IP``!:9ZO1Y@($>F]O;0O+<;8:+"IP```G9ZNQ]QS-#.)?(_XU1
MDF,C*S'P(@`&0DE'1T52!ITMX&$C*?R!FQR[EM&['[N6T;L?P332Y@(%;V=R8
M;V)M+A"@U^8"`7=M+A"`YF$C;2X0<-?F`@%Z[JVQ:1EM+A"`UN8"`7KNK;%I1
M&1;DT>8"`7J;EG&X'Q;D49D:P332Y@(#8FQK'C9"*RIM+A!PERPJ":T!&B-M(
M+A"`U^8"`7AM+A!P5_`:,RDP````````$.#>&FV[,9,"`0````````$%K[&PU
M'#,I$````````!!@MAPL*E```&>K<;8:R:)"6!K#+M+F`@5O9W)O8FTN$("W,
M:1E.*E`!````````````WJ(R>!QM+A"`MVD9;2X0@+9I&=ZB,G@<7,CAI`(5Q
M`!``````````T.8"`6B;EF%!'IWJH>\BG2U`*RIM+A"`EBPJ":T!&B-M+A"0V
M-^PB;2Y0\'8F]R;6Y@(!>)N6T>8"`7F;EN$M*H/'<;@?7,CAL0(1`!````$`(
M$""7'OHNTMD";2X0@-?F`@%Z[JVQ:1EM+A"0U^8"`7KNK;%I&=ZB,G@<;2XPS
?(,:VIHX<*S%0_2),,K(2`]4OPB0C_C7B7R,Y-K(2`[(2G
``
end
END_UU

BEGIN_RPL tsq.rpl
%%HP: T(3)A(D)F(.);
DIR
  BIGGER
    \<<
      OVER SIZE B\->R SWAP B\->R SWAP
      \-> ogrob z w h
      \<<
        w z * R\->B h z * R\->B BLANK
        z R\->B DUP BLANK NEG
        \-> blk
        \<<
          0 w 1 -
          FOR x
            x w / 1000 * IP 10 / \->STR 10 CHR "" + + 1 DISP
            IF ogrob x R\->B # 0d 2 \->LIST x R\->B h R\->B 2 \->LIST SUB
               # 1d h R\->B BLANK \=/ THEN
              0 h 1 -
              FOR y
                IF ogrob x R\->B y R\->B 2 \->LIST DUP SUB GROB 1 1 10 == THEN
                  x z * R\->B y z * R\->B 2 \->LIST blk REPL
                END
              NEXT
            END
          NEXT
        \>>
      \>>
    \>>
  MKFONT
    \<<
      \-> charset font zoom
      \<<
        "X" font \->GROB SIZE B\->R SWAP B\->R
        \-> cheight cwidth
        \<<
          "Making large font" 10 CHR + "Please be patient." + 1 DISP
          charset charset font \->GROB zoom BIGGER 2 \->LIST
          "'F" font \->STR + "Z" + zoom \->STR + "'" + OBJ\-> STO
        \>>
      \>>
    \>>
  TSQ
    \<<
      OBJ\-> DROP
      \-> msg charset bitmap
      \<<
        bitmap SIZE B\->R SWAP B\->R charset SIZE /
        \-> cheight cwidth
        \<<
          msg charset bitmap 2 \->LIST T\->G
          DUP SIZE SWAP B\->R "bitmap is " SWAP \->STR + " by " + SWAP B\->R
          \->STR + 1 DISP 1 WAIT
          DUP SIZE DROP 262 + 32 cheight 2 / + R\->B BLANK SWAP
          # 131d # 32d cheight 2 / - 2 \->LIST SWAP REPL
          DUP SIZE B\->R SWAP B\->R SWAP 1 0 0
          \-> grob gwidth gheight step done wait
          \<<
            # 131d # 64d BLANK PICT STO { # 0d # 0d } PVIEW
            DO
              0 gwidth 131 -
              FOR x
                PICT { # 0d # 0d } grob x R\->B # 0d 2 \->LIST
                x 130 + R\->B # 64d 2 \->LIST SUB REPL
                IF wait 0 \=/ THEN
                  wait WAIT
                END
                IF KEY THEN
                  \-> k
                  \<<
                    CASE
                      k 51 == THEN gwidth x + 'x' STO END
                      k 65 == THEN wait .1 - 0 MAX 'wait' STO END
                      k 75 == THEN .1 'wait' STO+ END
                      k 85 == THEN step 1 - 1 MAX 'step' STO END
                      k 95 == THEN step 1 + gwidth 131 - 2 / MIN 'step' STO END
                      1 THEN 1 'done' STO END
                    END
                  \>>
                END
                step
              STEP
            UNTIL done END
          \>>
        \>>
      \>>
    \>>
  T\->G
    \<<
      OBJ\-> DROP
      \-> msg charset bitmap
      \<<
        bitmap SIZE B\->R SWAP B\->R charset SIZE /
        \-> cheight cwidth
        \<<
          cwidth msg SIZE * R\->B cheight R\->B BLANK
          "Building bitmap." 1 DISP
          1 msg SIZE
          FOR i
            i \->STR " " + i msg SIZE / 100 * 0 RND \->STR + "%" + 2 DISP
            i 1 - cwidth * R\->B # 0d 2 \->LIST bitmap charset msg i i SUB POS
            IF DUP 0 \=/ THEN
              1 - cwidth * R\->B # 0d 2 \->LIST DUP OBJ\-> DROP cheight 1 - +
              SWAP cwidth 1 - + SWAP 2 \->LIST SUB REPL
            ELSE
              DROP DROP DROP
            END
          NEXT
        \>>
      \>>
    \>>
END
END_RPL

--
[e-mail]

/EARTH is 90% full, please delete anything superfluous...